module Data.Binary.Get.Internal where
import Prelude

import Control.Alternative (class Alt, class Alternative, class Plus)
import Control.Apply (applySecond)
import Control.Monad.Error.Class (class MonadThrow, throwError)
import Data.Array (drop, filter, fold, reverse, (:))
import Data.BigInt (BigInt)
import Data.ByteString as B
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect.Console (error)
import Unsafe.Coerce (unsafeCoerce)

data Decoder a = Fail B.ByteString  String 
             |   Partial (Maybe B.ByteString -> Decoder a)
             |   Done B.ByteString a
             |   BytesRead BigInt (BigInt -> Decoder a)

type Success a r = B.ByteString -> a -> Decoder r

newtype Get a = C {
    runCont::forall r.B.ByteString ->
                      Success a r  ->
                      Decoder r
}

instance functorGet :: Functor Get where
  map f (C m) = C {
                    runCont: (\i ks -> m.runCont i (\i' a -> ks i' (f a)))
                  }

instance applyGet :: Apply Get where
  apply d e = do
              b <- d
              a <- e
              pure (b a) 

instance bindGet :: Bind Get where
  bind (C c) f = C {
                     runCont:(\i ks -> c.runCont i (\i' a -> case (f a) of
                                                              (C cc) -> cc.runCont i' ks))
                   }

instance applicativeGet :: Applicative Get where
  pure = \x -> C { runCont:(\s ks-> ks s x) }

instance monadGet :: Monad Get
instance monadThowGet :: MonadThrow String Get where
  throwError str =C { runCont:(\i _ks -> Fail i str) }

instance altGet :: Alt Get where
   alt f g = do
      decoder /\ bs <- runAndKeepTrack f
      case decoder of
        Done inp x -> C {runCont:(\_ ks-> ks inp x)}
        Fail _ _   -> pushBack bs `applySecond` g
        _          -> unsafeCoerce $ error "Binary:impossible"

instance plusGet :: Plus Get where
 empty = C {runCont:(\inp _ks -> Fail inp "Data.Binary.Get(Alternative).empty")}

instance alternativeGet :: Alternative Get



runAndKeepTrack :: forall a. Get a -> Get (Tuple (Decoder a) (Array B.ByteString))
runAndKeepTrack (C g) = C {
  runCont:(\inp ks -> 
                    let r0       = g.runCont inp (\inp' a -> Done inp' a)
                        go acc r = case r of
                                     Done inp' a  -> ks inp (Done inp' a /\ reverse acc)
                                     Partial k    -> Partial $ \minp -> go (maybe acc (\arg -> arg : acc) minp) (k minp)
                                     Fail  inp' s -> ks inp (Fail inp' s /\ reverse acc)
                                     BytesRead unused k -> BytesRead unused (go acc <<< k)
                    in go [] r0
          )
}

pushBack::Array B.ByteString -> Get Unit
pushBack [] = C {runCont:(\inp ks -> ks inp unit)}
pushBack bs = C {runCont:(\inp ks -> ks (fold $ (inp : bs)) unit)}

get::Get B.ByteString
get = C {runCont:(\inp ks -> ks inp inp)}

put::B.ByteString -> Get Unit
put s = C {runCont:(\_inp ks -> ks s unit)}



readN::forall a. Int -> (B.ByteString -> a) -> Get a
readN n f = ensureN n *> unsafeReadN n f

--unsafeCoerce $ unsafePerformEffect $ error $ "Error : not enough bytes" <> (show $  inp)--
ensureN::Int -> Get Unit
ensureN n0 = C {
  runCont:(\inp ks -> do 
     if B.length inp >= n0
        then ks inp unit
        else case (withInputChunks n0 enoughChunks onSucc onFail >>= put) of (C v) -> v.runCont inp ks
  )}
 where
   enoughChunks n str
      | B.length str >= n = Right (str /\ B.empty)
      | otherwise = Left (n - B.length str)
   onSucc = fold <<< filter (\b -> B.length b > 0)
   onFail bss = C {runCont:(\_ _ -> Fail (fold bss) "not enough bytes")}

unsafeReadN ::forall a. Int -> (B.ByteString -> a) -> Get a
unsafeReadN n f = C {
  runCont:(\inp ks -> do
             ks (dropBS n inp) $ f inp
          )
}

dropBS::Int -> B.ByteString -> B.ByteString
dropBS n bs = B.pack $ drop n $  B.unpack bs 


type Consume s = s -> B.ByteString -> Either s (Tuple B.ByteString B.ByteString)

withInputChunks::forall s b. s -> Consume s -> (Array B.ByteString -> b) -> (Array B.ByteString -> Get b) -> Get b
withInputChunks initS consume onSucc onFail = go initS []
 where
  go state acc = C {
     runCont:(\inp ks ->
               case consume state inp of
                 Left state' -> do
                  let acc'  = inp : acc
                  let (C failV) = onFail (reverse acc') 
                  let (C goV)   = go state' acc'
                  prompt' (failV.runCont B.empty ks)
                          (\str' -> goV.runCont str' ks) 
                 Right (want /\ rest)-> do
                   ks rest (onSucc (reverse (want:acc)))
             )
  }

  prompt'::forall a. Decoder a -> (B.ByteString -> Decoder a) -> Decoder a
  prompt' kf ks = 
    let loop = Partial $ \sm -> 
                  case sm of
                   Just s | (B.length s) == 0 -> loop
                          | otherwise -> ks s
                   Nothing -> kf
    in loop



runGetIncremental ::forall a. Get a -> Decoder a
runGetIncremental (C g)  = noMeansNo $ g.runCont B.empty (\i a -> Done i a)

noMeansNo::forall a. Decoder a -> Decoder a
noMeansNo r0 = go r0
 where
  go r = 
   case r of
     Partial k     -> Partial (\ms -> 
       case ms of
         Just _ -> go (k ms)
         Nothing -> neverAgain (k ms)
     )
     BytesRead n k -> BytesRead n (go <<< k) 
     Done _ _      -> r
     Fail _ _      -> r
  neverAgain r = 
     case r of
       Partial k     -> neverAgain (k Nothing)
       BytesRead n k -> BytesRead n (neverAgain <<< k)
       Fail _ _      -> r
       Done _ _      -> r